{-# OPTIONS_GHC -fglasgow-exts -XRecordWildCards -XNamedFieldPuns -XTransformListComp #-}
module Hixay.UI.Editor where

import Graphics.UI.WX hiding (size)
import Graphics.UI.WXCore
-- .WxcClassesMZ
import XI.Directory.Types
import Data.Maybe
import Data.List
import Data.Tree
import Control.Arrow
import Control.Monad
import Data.Traversable
import Data.Foldable(sequenceA_)
import GHC.Exts(the)
import Hixay.UI.Tools

{--------------------------------------------------------------------------------
   Images
--------------------------------------------------------------------------------
imgComputer   = "computer"
imgDisk       = "disk"
imgFile       = "file"
imgHFile      = "hsicon"
imgFolder     = "f_closed"
imgFolderOpen = "f_open"

imgNone = ""

-- plain names of images
imageNames    
  = [imgComputer,imgDisk,imgFile,imgHFile,imgFolder,imgFolderOpen]

-- file names of the images
imageFiles
  = map (\name -> "./Bitmaps/" ++ name ++ ".ico") imageNames

-- get the index of an image
imageIndex :: String -> Int
imageIndex name = fromMaybe imageNone $ lookup name (zip imageNames [0..])

-- (-1) means no image present
imageNone :: Int
imageNone     = (-1)
---------------------------------------------------------------------------------}
treeCtrlSetItemAP :: TreeCtrl a -> TreeItem -> t -> IO ()
treeCtrlSetItemAP t it = treeCtrlSetItemClientData t it (return ())

treeCtrlGetItemAP :: TreeCtrl a -> TreeItem -> IO (Maybe t)
treeCtrlGetItemAP = unsafeTreeCtrlGetItemClientData
---------------------------------------------------------------------------------         
         
mkTree :: [Scenario] -> Tree (String, Maybe AdditionalParams)
mkTree scs = Node ("Chains", Nothing) [        
        Node (show $ the s_sys, Nothing) [
            Node (the s_int_s, max (Just blank_ap) $ the s_params_s) [
                Node (show $ the r_sys_si, Nothing) 
                    $ map (\ri -> Node (r_int ri, max (Just blank_ap) $ r_params ri) []) $ nub $ concat r_ints_si | 
                (r_sys_si, r_ints_si) <- map (r_sys &&& r_ints) $ nub $ concat receivers_s,
                then group by r_sys_si
            ] |
            (s_int_s, s_params_s, receivers_s) <- zip3 s_int s_params receivers,
            then group by (s_int_s, s_params_s)
        ] | 
        (s_sys, s_int, s_params, receivers) <- nub $ concatMap (
                map (\(Chain {chain_sender = Sender {s_sys, s_int, s_params}, chain_receivers}) -> (s_sys, s_int, s_params, chain_receivers))
            . scenario_chains) scs,
        then group by s_sys
    ]


mkTreeCtrl :: TreeCtrl a -> Tree t -> (t -> String) -> (t -> Maybe d) -> IO ()    
mkTreeCtrl tc tree to_str to_data = 
    treeCtrlAddRoot tc (to_str $ rootLabel tree) (-1) (-1) objectNull >>= set_data_child tree
        where
            set_data_child n it = 
                    traverse (treeCtrlSetItemAP tc it) (to_data $ rootLabel n) >> setTreeCtrl it (subForest n)
            setTreeCtrl parent_item nodes = 
                traverse (\n -> liftM ((,) n) (treeCtrlAppendItem tc parent_item (to_str $ rootLabel n) (-1) (-1) objectNull)) nodes >>= 
                    mapM_ (uncurry set_data_child)

editor :: forall a. Window a -> [Scenario] -> IO (Window a)
editor p scs = do
    windowDestroyChildren p
    s <- splitterWindow p []
    pLeft <- panel s []
    pRight <- panel s []
    t <- treeCtrl pLeft [enabled := True]
    mkTreeCtrl t tree fst snd
    
    ((pall, ape), tes) <- apEditor pRight
    set t [on treeEvent ::= onTreeEvent ape tes]
    
    windowSetLayout p $ fill $ vsplit s 5 160 (container pLeft $ fill $ widget t) (container pRight $ fill $ widget pall)
    return p
    where
        tree = mkTree scs
        
        to_stat lst = Just Statistics { min_val = f 0, max_val = f 1, avg_val = f 2 }
            where f n = read_nn $ lst!!n
        to_ap lst = AdditionalParams {
                XI.Directory.Types.size = to_stat $ take 3 lst, 
                cnt = f 3,
                cnt_day = to_stat $ take 3 $ drop 4 lst,
                regulations = f 7,
                allowable_time = f 8,
                features = f 9
            }
            where f n = read_nn $ lst!!n
        read_nn x 
            | null x = Nothing
            | otherwise = Just $ read x
        
        from_ap (AdditionalParams {..}) = from_st size ++ [show_nn cnt] ++ from_st cnt_day ++ 
            [fromMaybe "" regulations, show_nn allowable_time, fromMaybe "" features]
        from_st (Just Statistics {..}) = [show_nn min_val, show_nn max_val, show_nn avg_val]
        from_st Nothing = replicate 3 ""
        show_nn x = fromMaybe "" $ liftM show x
        
        onTreeEvent pAp tes tc ev = 
            case ev of
                TreeSelChanged itm _ 
                    | treeItemIsOk itm  -> do
                        mb <- treeCtrlGetItemAP tc itm 
                        set pAp [visible := isJust mb] 
                        sequenceA_ $ liftM (zipWithM_ (\te s -> set te [text := s]) tes . from_ap) mb
                        get pAp parent >>= refresh_
                        propagateEvent
                    | otherwise -> propagateEvent
                _ -> propagateEvent
        
        save_ap (KeyChar c) = infoDialog objectNull "< Hixay Inform >" ("save_ap: " ++ [c]) >> propagateEvent
        save_ap _ = propagateEvent
        
        apEditor pr = do 
            pAll <- panel pr []
            pTop <- panel pAll []
            b <- button pTop [text := "Apply changes", on command := apply_all]
            pd <- panel pAll []
            (pSize, tesSize) <- statEditor pd "Size"
            pCnt <- panel pd []
            teCnt <- textEntry pCnt [on anyKey := save_ap]
            (pCntDay, tesCntDay) <- statEditor pd "Count of days"
            pAdd <- panel pd []
            tes_add <- traverse (const $ textEntry pAdd [on anyKey := save_ap]) labs_add
            windowSetLayout pAll $ boxed "Additional parameters" $ column 5 [
                hfill $ container pTop $ widget b, 
                fill $ container pd $ column 5 [
                    hfill $ widget pSize,
                    container pCnt $ hfill $ row 20 $ mkRow "Count of all messages" teCnt,
                    hfill $ widget pCntDay,
                    container pAdd $ hfill $ grid 20 5 $ zipWith mkRow labs_add tes_add    
                ]] 
            get pd parent >>= refresh_
            return ((pAll, pd), tesSize ++ [teCnt] ++ tesCntDay ++ tes_add)
            where
                labs_add = ["Regulations of interaction", "Allowable response time", "Additional features"]
                statEditor pd sBox = do
                        pStat <- panel pd []
                        tes <- traverse (const $ textEntry pStat [on anyKey := save_ap]) labs
                        windowSetLayout pStat $ boxed sBox $ grid 20 5 $ zipWith mkRow labs tes
                        return (pStat, tes)
                    where
                        labs = ["Min value", "Max value", "Avg value"] 
                apply_all = return ()